

(defun dist (row1 row2)
    (sqrt (sum (** (- row1 row2) 2))))


(defun quick-cluster ( numclusters &key (matrixdata (send *current-data* :active-data-matrix '(numeric))) (plot *current-plot*) (iter 10) (min-change 1))
  (let ((plot plot)
        (initial-means)
        (min-dist-initial-cluster-centers)
        (matrixdata (normalize matrixdata))
        (iter iter)
        (min-change min-change)
        (numclusters numclusters)
        (res)
        (cluster-membership)
        (prev-initial-means)
        )
        
  (when plot (send plot :point-color (iseq (array-dimension matrixdata '0)) 'black))
  (setf initial-means (initial-cluster-centers matrixdata numclusters))
  (setf min-dist-initial-cluster-centers (first (closer-means initial-means))) 
  (dotimes (i iter)
           (setf initial-means     (update-initial-cluster-centers matrixdata initial-means))
           (setf res (assign-cases-to-nearest-cluster matrixdata initial-means plot))
           (setf cluster-membership (first res))
           (setf initial-means (second res))
           (print (* min-change min-dist-initial-cluster-centers))
           (when prev-initial-means (print (max (abs (- prev-initial-means initial-means)))))
           (when prev-initial-means
                 (when (> (* min-change min-dist-initial-cluster-centers) 
                    (max (abs (- prev-initial-means initial-means))))
                 (return)))
           (setf prev-initial-means (copy-list initial-means))
           (print (strcat "Iter" (princ-to-string i)))
           )
        cluster-membership
))



(defun update-initial-cluster-centers (matrixdata initial-means)
  (let* ((matrixdata matrixdata)
         (initial-centers initial-means)
         (close-cluster)
         (cluster-group)
         )
    (dotimes (i (array-dimension matrixdata '0))
             (setf close-cluster (first (closer-mean-to-row (row matrixdata i) initial-centers)))
             (push close-cluster cluster-group )
             (setf (select initial-centers close-cluster) 
                  (/ (+ (* (+ 1 i) (select initial-centers close-cluster))
                                 (row matrixdata i)) (+ 2 i)))
             )
    initial-centers))


(defun assign-cases-to-nearest-cluster (matrixdata initial-means &optional plot)
  (let* ((matrixdata matrixdata)
         (initial-centers initial-means)
         (close-cluster)
         (cluster-group)
         (plot plot)
         (colors (list 'green 'orange 'cyan 'magenta  'red 'blue 'yellow 'DARK-GREEN  'pink  'brown    'violet 'light-blue  'dark-red 'BLACK  ))
         )
    
                         
    (dotimes (i (array-dimension matrixdata '0))
             (setf close-cluster (first (closer-mean-to-row (row matrixdata i) initial-centers)))
             (push close-cluster cluster-group)
             (when plot 
                   (send plot :point-color i
                         (select colors close-cluster))
                   (send plot :redraw)
                   )
             )
   ; (when plot  (send plot :add-points (column-list (apply 'bind-rows initial-centers)) :symbol 'X) (send plot :redraw))
    (list (reverse cluster-group) initial-centers))
             )

(defun closer-means (means-list)
  (let* ((initial-means means-list)
         (closer-means (list 0 1))
         (min-dist (dist (select initial-means (first closer-means))
                         (select initial-means (second closer-means))))
         (curr-dist)
         (numclusters (length means-list))
         )
    (dotimes (i numclusters)
             (dotimes (j numclusters)
                      (when (< j i)
                          (setf curr-dist (dist (select initial-means i)
                                                (select initial-means j)))
                          (when (> min-dist curr-dist)
                                (setf closer-means (list i j))
                                (setf min-dist curr-dist)))))
    (list min-dist closer-means)))

(defun closer-mean-to-row (row means-list)
  (let* ((row row)
         (means-list means-list)
         (distances (mapcar #'(lambda (m) (dist row m)) means-list))
         (min-dis (min distances))
         (second-min-dist (second (sort-data distances)))
         (closer-mean-to-row (which (mapcar #'(lambda (m) (= m min-dis)) distances)))
         (second-closer-mean-to-row (which (mapcar #'(lambda (m) (= m second-min-dist)) distances)))
         )
    (combine (list closer-mean-to-row second-closer-mean-to-row))))
    

(defun initial-cluster-centers (matrixdata numclusters &optional initial-centers)
  (let* (
         (matrixdata matrixdata)
         (numclusters numclusters)
         (initial-means (if (not initial-centers) (mapcar #'(lambda (nc) (coerce 
                                                (repeat '0 (array-dimension matrixdata '1))
                                                'vector))
                                    (iseq numclusters))
                            initial-centers))
         (closer-means)
         )
    (dotimes (i (array-dimension matrixdata '0))
             (setf closer-means (closer-means initial-means))
             (setf closer-means-to-row (closer-mean-to-row 
                                          (row matrixdata i)
                                          initial-means))
             
             (cond ((> (min (mapcar #'(lambda (initial-mean) 
                                        (dist (row matrixdata i) initial-mean))
                                    initial-means))
                       (first closer-means))
                    (if (> (dist (row matrixdata i)
                                 (select initial-means (first (second closer-means)))))
                        (setf (select initial-means (first (second closer-means)))
                              (row matrixdata i))
                        (setf (select initial-means (second (second closer-means)))
                              (row matrixdata i))))
               ((> (dist (row matrixdata i) 
                         (select initial-means
                                 (second closer-means-to-row)))
                   (min (mapcar #'(lambda (m) (dist m (select initial-means 
                                                                (first closer-means-to-row))))
                                         initial-means)))
                                                     
                (setf (select initial-means (first closer-means-to-row)) (row matrixdata i)))))
    initial-means))



;(quick-cluster 5)